home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / options.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  35KB  |  1,183 lines
  1. {
  2.     $Id: options.pas,v 1.3.2.2 1998/08/18 13:43:50 carl Exp $
  3.     Copyright (c) 1993-98 by the FPC development team
  4.  
  5.     Reads command line options and config files
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. unit options;
  24.  
  25. interface
  26.  
  27. {$I optmsg.inc}
  28. {$I optidx.inc}
  29.  
  30. type
  31.   POption=^TOption;
  32.   TOption=object
  33.     NoPressEnter,
  34.     Logowritten : boolean;
  35.     Constructor Init;
  36.     Destructor Done;
  37.     procedure Comment(l:longint;t:toptionconst);
  38.     procedure Comment1(l:longint;t:toptionconst;const s1:string);
  39.     procedure WriteLogo;
  40.     procedure WriteInfo;
  41.     procedure WriteHelpPages;
  42.     procedure IllegalPara(const opt:string);
  43.     procedure Setbool(const opts:string;var b:boolean);
  44.     procedure interpret_proc_specific_options(const opt:string);virtual;
  45.     procedure interpret_option(const opt :string);
  46.     procedure Interpret_file(const filename : string);
  47.     procedure Read_Parameters;
  48.   end;
  49.  
  50.   procedure get_exepath;
  51.   procedure read_arguments;
  52.  
  53. implementation
  54.  
  55. uses
  56.   cobjects,globals,systems,
  57.   verbose,dos,scanner,link,verb_def,messages,os2_targ
  58. {$ifdef i386}
  59.   ,opts386
  60. {$endif}
  61. {$ifdef m68k}
  62.   ,opts68k
  63. {$endif}
  64.   ;
  65.  
  66. const
  67.   page_size = 24;
  68. {$ifdef i386}
  69.   ppccfg : string = 'pp68k.cfg';
  70. {$else}
  71.   ppccfg : string = 'pp68k.cfg';
  72. {$endif}
  73.  
  74. var
  75.   readfilename,             { read filename from the commandline ? }
  76.   read_configfile,          { read config file, set when a cfgfile is found }
  77.   target_is_set : boolean;  { do not allow contradictory target settings }
  78.   msgfilename,
  79.   param_file    : string;   { file to compile specified on the commandline }
  80.   optionmsg     : pmessage;
  81.   option        : poption;
  82.  
  83. {****************************************************************************
  84.                                  Defines
  85. ****************************************************************************}
  86.  
  87. procedure def_symbol(const s : string);
  88. begin
  89.   if s='' then
  90.    exit;
  91.   commandlinedefines.concat(new(pstring_item,init(upper(s))));
  92. end;
  93.  
  94.  
  95. procedure undef_symbol(const s : string);
  96. var
  97.   item,next : pstring_item;
  98. begin
  99.   if s='' then
  100.    exit;
  101.   item:=pstring_item(commandlinedefines.first);
  102.   while assigned(item) do
  103.    begin
  104.      if (item^.str^=s) then
  105.       begin
  106.         next:=pstring_item(item^.next);
  107.         commandlinedefines.remove(item);
  108.         item:=next;
  109.       end
  110.      else
  111.       if item<>pstring_item(item^.next) then
  112.        item:=pstring_item(item^.next)
  113.       else
  114.        break;
  115.    end;
  116. end;
  117.  
  118.  
  119. function check_symbol(const s:string):boolean;
  120. var
  121.   hp : pstring_item;
  122. begin
  123.   hp:=pstring_item(commandlinedefines.first);
  124.   while assigned(hp) do
  125.    begin
  126.      if (hp^.str^=s) then
  127.       begin
  128.         check_symbol:=true;
  129.         exit;
  130.       end;
  131.      hp:=pstring_item(hp^.next);
  132.    end;
  133.   check_symbol:=false;
  134. end;
  135.  
  136. {****************************************************************************
  137.                                  Toption
  138. ****************************************************************************}
  139.  
  140.  
  141. procedure Toption.Comment(l:longint;t:toptionconst);
  142. begin
  143.   if (Verbosity and l)<>0 then
  144.    WriteLn(optionmsg^.Get(ord(t)));
  145. end;
  146.  
  147.  
  148. procedure Toption.Comment1(l:longint;t:toptionconst;const s1:string);
  149. begin
  150.   if (Verbosity and l)<>0 then
  151.    WriteLn(optionmsg^.Get1(ord(t),s1));
  152. end;
  153.  
  154.  
  155. procedure Toption.WriteLogo;
  156. var
  157.   i : toptionconst;
  158. begin
  159.   if Logowritten then
  160.    exit;
  161.   for i:=logo_start to logo_end do
  162.    Comment1(V_Default,i,target);
  163.   Logowritten:=true;
  164. end;
  165.  
  166.  
  167. procedure Toption.WriteInfo;
  168. var
  169.   i : toptionconst;
  170. begin
  171.   for i:=info_start to info_end do
  172.    Comment(V_Default,i);
  173.   Stop;
  174. end;
  175.  
  176.  
  177. procedure Toption.WriteHelpPages;
  178.  
  179.   function PadEnd(s:string;i:longint):string;
  180.   begin
  181.     while (length(s)<i) do
  182.      s:=s+' ';
  183.     PadEnd:=s;
  184.   end;
  185.  
  186. var
  187.   lastident,
  188.   i,j,
  189.   outline,
  190.   ident,
  191.   lines : longint;
  192.   show  : boolean;
  193.   opt   : string[32];
  194.   input,
  195.   s     : string;
  196. begin
  197.   Write(paramstr(0));
  198.   Comment(V_Default,usage);
  199.   lastident:=0;
  200.   if logowritten then
  201.    lines:=3
  202.   else
  203.    lines:=1;
  204.   for i:=1 to optionhelplines do
  205.    begin
  206.    { get a line and reset }
  207.      s:=optionmsg^.Get(ord(endoptionconst)-1+i);
  208.      ident:=0;
  209.      show:=false;
  210.    { parse options }
  211.      case s[1] of
  212. {$ifdef i386}
  213.       '3',
  214. {$endif}
  215. {$ifdef m68k}
  216.       '6',
  217. {$endif}
  218.       '*' : show:=true;
  219.      end;
  220.      if show then
  221.       begin
  222.         case s[2] of
  223. {$ifdef linux}
  224.          'L',
  225. {$endif}
  226. {$ifdef os2}
  227.          'O',
  228. {$endif}
  229.          '*' : show:=true;
  230.         else
  231.          show:=false;
  232.         end;
  233.       end;
  234.    { now we may show the message or not }
  235.      if show then
  236.       begin
  237.         case s[3] of
  238.          '0' : begin
  239.                  ident:=0;
  240.                  outline:=0;
  241.                end;
  242.          '1' : begin
  243.                  ident:=2;
  244.                  outline:=7;
  245.                end;
  246.          '2' : begin
  247.                  ident:=11;
  248.                  outline:=9;
  249.                end;
  250.          '3' : begin
  251.                  ident:=21;
  252.                  outline:=6;
  253.                end;
  254.         end;
  255.         j:=pos('_',s);
  256.         opt:=Copy(s,4,j-4);
  257.         if opt='*' then
  258.          opt:=''
  259.         else
  260.          opt:=PadEnd('-'+opt,outline);
  261.         if (ident=0) and (lastident<>0) then
  262.          begin
  263.            Writeln;
  264.            inc(Lines);
  265.          end;
  266.       { page full ? }
  267.         if (lines>=page_size) then
  268.          begin
  269.            if not NoPressEnter then
  270.             begin
  271.               write('*** press enter ***');
  272.               readln(input);
  273.               if upper(input)='Q' then
  274.                stop;
  275.             end;
  276.            lines:=0;
  277.          end;
  278.         WriteLn(PadEnd('',ident)+opt+Copy(s,j+1,255));
  279.         LastIdent:=Ident;
  280.         inc(Lines);
  281.       end;
  282.    end;
  283.   stop;
  284. end;
  285.  
  286.  
  287. procedure Toption.IllegalPara(const opt:string);
  288. begin
  289.   Comment1(V_Default,illegal_para,opt);
  290.   Comment(V_Default,help_pages_para);
  291.   stop;
  292. end;
  293.  
  294.  
  295. procedure Toption.Setbool(const opts:string;var b:boolean);
  296. var
  297.   i : longint;
  298. begin
  299.   b:=true;
  300.   for i:=3 to length(opts) do
  301.    case opts[i] of
  302.     '-' : b:=false;
  303.     '+' : b:=true;
  304.    else
  305.     IllegalPara(opts);
  306.    end;
  307. end;
  308.  
  309.  
  310. procedure TOption.interpret_proc_specific_options(const opt:string);
  311. begin
  312. end;
  313.  
  314.  
  315. procedure TOption.interpret_option(const opt:string);
  316. var
  317.   code : word;
  318.   c    : char;
  319.   more : string;
  320.   j    : longint;
  321. begin
  322.   if opt='' then
  323.    exit;
  324.   case opt[1] of
  325.  '-' : begin
  326.          more:=Copy(opt,3,255);
  327.          case opt[2] of
  328.               '?' : WriteHelpPages;
  329.               'h' : begin
  330.                       NoPressEnter:=true;
  331.                       WriteHelpPages;
  332.                     end;
  333.               'a' : writeasmfile:=true;
  334. {$ifdef tp}
  335.               'b' : setbool(opt,use_big);
  336. {$endif}
  337.               'B' : if more='' then
  338.                      do_build:=true
  339.                     else
  340.                      IllegalPara(opt);
  341.               'C' : begin
  342.                       for j:=1 to length(more) do
  343.                        case more[j] of
  344.                         'a','e' : ;
  345.                             'h' : begin
  346.                                     val(copy(more,j+1,length(more)-j),heapsize,code);
  347.                                     if (code<>0) or (heapsize>=67107840) or (heapsize<1024) then
  348.                                      IllegalPara(opt);
  349.                                     break;
  350.                                   end;
  351.                             'i' : initswitches:=initswitches+[cs_iocheck];
  352.                             'n' : initswitches:=initswitches+[cs_n